unit MemMap;

interface
     uses Windows, SysUtils, Classes;

type

EMMFError = class(Exception);  //Khai bao lp loi

TMemMapFile = class

private
        FFileName: String;  
        FSize: Longint;       
        FFileSize: Longint; 
        FFileMode: Integer; 
        FFileHandle: Integer;
        FMapHandle: Integer;
        FData: PByte; 
        FMapNow: Boolean; 

        procedure AllocFileHandle;

        procedure AllocFileMapping;

        procedure AllocFileView;

        function GetSize: Longint;

public
        constructor Create(FileName: String;    
                                              FileMode: integer;
                                             Size: integer; 
                                             MapNow: Boolean); virtual;
        
        destructor Destroy; override;

        procedure FreeMapping;

        property Data: PByte read FData;
        property Size: Longint read GetSize;
        property FileName: String read FFileName;
        property FileHandle: Integer read FFileHandle;
        property MapHandle: Integer read FMapHandle;
end;

implementation

constructor TMemMapFile.Create(FileName: String;
                               FileMode: integer;
                               Size: integer; MapNow: Boolean);
begin
        FMapNow := MapNow;
        FFileName := FileName;
        FFileMode := FileMode;

        AllocFileHandle; 
        FFileSize := GetFileSize(FFileHandle, Nil);
        FSize := Size;
        try
                AllocFileMapping; 
        except
               on EMMFError do begin
                   CloseHandle(FFileHandle); 
                   FFileHandle := 0; 
                   raise;
                end;
        end;

        if FMapNow then
                AllocFileView; 
end;

destructor TMemMapFile.Destroy;
begin
        if FFileHandle <> 0 then
                CloseHandle(FFileHandle);
        if FMapHandle <> 0 then
                CloseHandle(FMapHandle);
        
        FreeMapping;

        inherited Destroy;
end;


procedure TMemMapFile.FreeMapping;
begin
        if FData <> Nil then
        begin
                UnmapViewOfFile(FData);
                FData := Nil;
        end;
end;

function TMemMapFile.GetSize: Longint;
begin
        if FSize <> 0 then
                Result := FSize
        else
                Result := FFileSize;
end;

procedure TMemMapFile.AllocFileHandle;
begin
        if FFileMode = fmCreate then
                FFileHandle := FileCreate(FFileName)
        else
                FFileHandle := FileOpen(FFileName, FFileMode);
        if FFileHandle < 0 then
                raise EMMFError.Create('Failed to open 
                                                                        or create file');
end;

procedure TMemMapFile.AllocFileMapping;
var
        ProtAttr: DWORD;
begin
        if FFileMode = fmOpenRead then  
                ProtAttr := Page_ReadOnly
        else
                ProtAttr := Page_ReadWrite;

        FMapHandle := CreateFileMapping(FFileHandle, Nil,
                                        ProtAttr,0, FSize, Nil);
        if FMapHandle = 0 then
                raise EMMFError.Create('Failed to create 
                                                                         file mapping');
end;

procedure TMemMapFile.AllocFileView;
var
        Access: Longint;
begin
        if FFileMode = fmOpenRead then 
                Access := File_Map_Read
        else
                Access := File_Map_All_Access;

        FData := MapViewOfFile(FMapHandle, Access, 0,
                                                                                0, FSize);

        if FData = Nil then
                raise EMMFError.Create('Failed to map view 
                                                                                 of file');
end;
end.
